home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / blas / dmach.f < prev    next >
Text File  |  1996-07-19  |  1KB  |  59 lines
  1.       DOUBLE PRECISION FUNCTION DMACH(JOB)
  2.       INTEGER JOB
  3. C
  4. C     SMACH COMPUTES MACHINE PARAMETERS OF FLOATING POINT
  5. C     ARITHMETIC FOR USE IN TESTING ONLY.  NOT REQUIRED BY
  6. C     LINPACK PROPER.
  7. C
  8. C     IF TROUBLE WITH AUTOMATIC COMPUTATION OF THESE QUANTITIES,
  9. C     THEY CAN BE SET BY DIRECT ASSIGNMENT STATEMENTS.
  10. C     ASSUME THE COMPUTER HAS
  11. C
  12. C        B = BASE OF ARITHMETIC
  13. C        T = NUMBER OF BASE  B  DIGITS
  14. C        L = SMALLEST POSSIBLE EXPONENT
  15. C        U = LARGEST POSSIBLE EXPONENT
  16. C
  17. C     THEN
  18. C
  19. C        EPS = B**(1-T)
  20. C        TINY = 100.0*B**(-L+T)
  21. C        HUGE = 0.01*B**(U-T)
  22. C
  23. C     DMACH SAME AS SMACH EXCEPT T, L, U APPLY TO
  24. C     DOUBLE PRECISION.
  25. C
  26. C     CMACH SAME AS SMACH EXCEPT IF COMPLEX DIVISION
  27. C     IS DONE BY
  28. C
  29. C        1/(X+I*Y) = (X-I*Y)/(X**2+Y**2)
  30. C
  31. C     THEN
  32. C
  33. C        TINY = SQRT(TINY)
  34. C        HUGE = SQRT(HUGE)
  35. C
  36. C
  37. C     JOB IS 1, 2 OR 3 FOR EPSILON, TINY AND HUGE, RESPECTIVELY.
  38. C
  39.       DOUBLE PRECISION EPS,TINY,HUGE,S
  40. C
  41.       EPS = 1.0D0
  42.    10 EPS = EPS/2.0D0
  43.       S = 1.0D0 + EPS
  44.       IF (S .GT. 1.0D0) GO TO 10
  45.       EPS = 2.0D0*EPS
  46. C
  47.       S = 1.0D0
  48.    20 TINY = S
  49.       S = S/16.0D0
  50.       IF (S*1.0 .NE. 0.0D0) GO TO 20
  51.       TINY = (TINY/EPS)*100.0
  52.       HUGE = 1.0D0/TINY
  53. C
  54.       IF (JOB .EQ. 1) DMACH = EPS
  55.       IF (JOB .EQ. 2) DMACH = TINY
  56.       IF (JOB .EQ. 3) DMACH = HUGE
  57.       RETURN
  58.       END
  59.